Shareware Grab Bag/Shareware Grab Bag.iso/003/pssst.arc/PSREORDR.PRG

Text File | 1986-07-16 | 5.5 KB | 187 lines

* PSREORDR.PRG
*
* A DBASE II 16BIT COMMAND FILE which looks for duplicate priorities
* then forces change
*
* Version 1
* By LTC Denny Hugg
* ANGSC/DOS Andrews AFB MD 16 Jul 1985
*
* Version 2
* modified by Maj Jim McMurry
* ANGSC/DOSC Truax Field, WI 15 Jun 1986
*
ERASE
STORE 'P R I O R I T Y   R E - O R D E R I N G' TO heading
DO PSHEADING
USE &gsusfile
GO BOTTOM
STORE # TO last
IF last = 0
   STORE 10 TO line
   STORE 'You Have No Suspense Items ' + gfirstname TO prompt
   DO PSPROMPT
   STORE 12 TO line
   STORE ' Returning To Priority Management Menu' TO prompt
   DO PSPROMPT
   STORE 0 TO timer
   DO WHILE TIMER < gdelay
      STORE timer + 1 TO timer
   ENDDO
   USE
   RETURN
ENDIF
* --- indexed on priority
USE &gsusfile INDEX &gpryindex
* --- find the last zero priority
STORE 0 TO lastzero
DO WHILE priority = '0.00'
   STORE # TO lastzero
   SKIP
   LOOP
ENDDO
IF EOF
   STORE 10 TO line
   STORE 'You Have No Priorities To Analyze' +gfirstname TO prompt
   DO PSPROMPT
   STORE 12 TO line
   STORE 'Returning To Priority Management Menu' TO prompt
   DO PSPROMPT
   STORE 0 TO timer
   DO WHILE timer < gdelay
      STORE timer + 1 TO timer
   ENDDO
   USE
   RELEASE ALL EXCEPT g*
   RETURN
ENDIF
DO WHILE T
   ERASE
   @ 10,21 SAY 'Searching For Duplicate Priorities ...'
   STORE 'N' TO duplicate
   * --- find duplicate priorities
   DO WHILE .NOT. EOF .AND. duplicate = 'N'
      STORE priority TO oldprio
      STORE # TO firstdup
      SKIP
      STORE priority TO newprio
      * --- the priorities are the same
      IF .NOT. EOF .AND. oldprio = newprio .AND. priority <> '0.00'
         STORE 'Y' TO duplicate
      ENDIF
   ENDDO
   IF duplicate = 'Y'
      * --- position on first duplicate
      GO firstdup
      ERASE
      STORE 1 TO line
      STORE 'DUPLICATE PRIORITIES' TO prompt
      DO PSPROMPT
      @  4, 0 SAY 'Rec #  Prio  Description'
      @  4,70 SAY 'Due Date'
      @  5, 0 SAY gline
      * --- display the duplicates
      DO WHILE .NOT. EOF .AND. priority = oldprio
         DISPLAY priority + '  ' + descrip + '  ' + duedate
         SKIP
      ENDDO
      STORE '     ' TO select
      @  0, 0 SAY gcuron
      DO WHILE select = '     '
         @ 22,79 SAY '              ';
                    +'You Have Duplicates ... Enter Record # To Change ';
                 GET select PICTURE '99999'
         READ NOUPDATE
      ENDDO
      @  0, 0 SAY gcuroff
      @ 22,79 SAY gclearline
      IF $(select,1,1) = ' '
         * --- he added some leading space(s)
         STORE 1 TO pointer
         * --- locate the first non-empty character
         DO WHILE $(select,pointer,1) = ' '
            STORE pointer + 1 TO pointer
         ENDDO
         * --- get the non-empty characters
         STORE $(select,pointer,LEN(select)-pointer + 1) TO select
      ENDIF
      * --- we may use this if the record doesn't exist
      STORE TRIM(select) TO recno
      STORE '0000' TO zeros
      STORE $(zeros,1,5-LEN(recno)) + recno TO recno
      IF VAL(recno) > last
         @ 22,79 SAY gclearline
         @ 22,79 SAY '                        ';
                   + 'There Is No ' + recno + ' In Your Database'
         STORE 1 TO timer
         DO WHILE timer < gdelay
            STORE timer + 1 TO timer
         ENDDO
         GO firstdup
         STORE '     ' TO select
         LOOP
      ENDIF
      RELEASE select
      GO VAL(recno)
      STORE '    ' TO mpriority
      @  0, 0 SAY gcuron
      @ 22,79 SAY '             '+;
                'The Present Priority is '+priority+' ... Enter New Priority ';
              GET mpriority PICTURE '9.99'
      READ NOUPDATE
      @  0, 0 SAY gcuroff
      * --- fill in other zeros as priority is a character field
      STORE TRIM(mpriority) TO mpriority
      IF mpriority = ' .' .OR. mpriority = '0.' .OR. mpriority = '0.0'
         STORE '0.00' TO mpriority
      ELSE
         STORE '00' TO zeros
         STORE mpriority + $(zeros,1,4-LEN(mpriority)) TO mpriority
      ENDIF
      IF mpriority <> priority
         REPLACE priority with mpriority
         * --- go back to beginning in case he made a low priority a high one
         IF lastzero <> 0
            GO lastzero
         ELSE
            * --- there were no 0 priorities
            GO TOP
         ENDIF
      ELSE
         @ 22,79 SAY gclearline
         @ 22,79 SAY '                      ';
                    +"That's The Same Priority ... Try Again'
         * --- redisplay the list of records just as they were
         GO firstdup
      ENDIF
   ELSE
      @ 10, 0 SAY gclearline
      STORE 10 TO line
      STORE 'There Are No Duplicate Priorities In Your File ';
                           + gfirstname TO prompt
      DO PSPROMPT
      STORE 12 TO line
      STORE 'Proceeding To View Your Priorities Now' TO prompt
      DO PSPROMPT
      STORE 0 TO timer
      DO WHILE timer < gdelay
         STORE timer + 1 TO timer
      ENDDO
      USE
      RELEASE ALL EXCEPT g*
      DO PSVIEWPR
      RETURN
   ENDIF
ENDDO T
* EOF PSREORDR.PRG
pointer + 1 TO pointer
         ENDDO
         * --- get the non-empty characters
         STORE $(select,pointer,LEN(select)-pointer + 1) TO select
      ENDIF
      * --- we may use this if the record doesn't exist
      STORE TRIM(select) TO recno
      STORE '0000' TO zeros
      STORE $(zeros,1,5-LEN(recno)) + recno TO recno
      IF VAL(recno) > last
         @ 22,7